#light

(* Key data model concepts.
 - Schema separate from data.  Does schema/data define anything more than just 
    data?  That should depend on communication with the data model.
    
 - Schema defines interface to the data.
 - Totally dynamic, at least for adding.
 - Just figure out the data model behind adding projects and such;
 - serialization is not the key issue.
 - Should it in fact be graph based?
 - Difficult to visualize; at least more difficult than classes.
 - extensible; more extensible than classes.
 - schema interface really a UI thing?  Not useful outside of UI?
 - Specialized nodes for different purposes; but does that break model?
 - Graph access through very specific interface.  What is granularity
     of interface?
 - Purpose is unclear.  
    - Unified data model automates undo/redo; makes animating properties much easier.
    - Ensures all resources are released upon exist.  Does it care about automation?
    - Does the data layer sit above/below the graph structure?  Perhaps intermediate
        systems was very appropriate.  Combination of objects and property graphs.  But
        that seems to really indicate just one large property graph, objects are just
        wrappers on top of property graph.  If I could describe graph in terms
        of object interfaces, then I would be back at the code generation phase.
        Really, should create the graph, data layer, then you could code-generate
        from that.
        
    - What boundary between the graph and custom objects?  Does it really matter,
        as long as they use the same data layer to communicate information?
        Seems the custom objects should be built on top of graph; meaning
        data layer and graph are exactly the same, and there would be
        another layer on top.  
    - How high does the graph structure sit?  
    - Vertexes - can contain value, vertex type?
    - Property edges - conditional?
    - Does this mean that there are a core set of vertexes (datatype vertexes) the
    - data layer supports explicitly?
    - Collection edge?
    - Enough information should be saved with the data to allow stupid read of
        the data.  Thus only basic schema definition.  Does this include conditional
        edges?  Or just edges that are live at the time.  I believe it would mean
        all set edges, as that would preserve the most information possible.
        Non-conditional edges then.
    - Same design as schema.  Simple types, arrays of simple types.  Object which implies
        unique identifier.  Do object's contain values themselves?  What use does that
        serve outside.  If they don't contain objects then data would indicate
        terminal symbol.  Multiple derivation.
    - Path based access just makes way too much sense.  So handle-based access?  Then
    - on load how to find paths?  Fudge it.
    - Double, Sequence of doubles; string, Sequence of strings; integer, sequence of integers, sequence of bytes
    - Yay LISP!
    - String keys?  Integer keys?
    - What contract does a piece of data need to have with the system?
    *)
module CGraph.DataModel
open CGraph.Generic
open CGraph.Generic.Algorithms
open CGraph.Generic.Impl
open Microsoft.FSharp.Collections
open CGraph.IO;

//more types later; probably toBytes and fromBytes.
type DataModelDataEntry(m_datatype:string,value:obj) = 
    let mutable m_value = value
    member s.Value 
        with get = m_value 
        and set (arg:obj) = m_value <- arg
    member s.Datatype = m_datatype
    
    
    interface INamedObject with
        member s.Name = m_datatype
    
type DataModelDataEntryHandle = DataModelDataEntry Handle

type DataModelData = { HandleSystem:ObjectHandleSystem; }

let CreateDataModelData incFunc = 
    let system = CreateObjectHandleSystem incFunc
    { HandleSystem=system; }

type IDataModel =
    abstract Create : datatype:string*data:obj -> DataModelDataEntryHandle
    abstract GetData : hdl:DataModelDataEntryHandle -> obj
    abstract SetData : hdl:DataModelDataEntryHandle * data:obj -> unit
    abstract Remove : hdl:DataModelDataEntryHandle -> unit

let CreateDataModel (store:DataModelData) =
    let GetOrCreateObjHandle = store.HandleSystem.GetOrCreateObjHandle
    let GetHandleObj = store.HandleSystem.GetHandleObj
    let ToHandle value = store.HandleSystem.ToHandle value
    let FromHandle hdl = store.HandleSystem.FromHandle hdl
    
    { new IDataModel 
        with
            member s.Create (datatype,data) =
                let newEntry = DataModelDataEntry(datatype,data)
                ToHandle newEntry
            member s.GetData hdl =
                let data = FromHandle hdl
                data.Value
            member s.SetData (hdl,data) =
                let entry = FromHandle hdl
                entry.Value <- data
            member s.Remove hdl =
                let entry = store.HandleSystem.HandleIndex.Items.[hdl.Handle]
                store.HandleSystem.ObjectMap.Remove entry |> ignore
    }

type OnDataTypeCreate = delegate of name:DataModelDataEntryHandle*value:DataModelDataEntry->unit
type OnPropertySet = delegate of handle:DataModelDataEntryHandle*oldValue:obj*newValue:obj->unit
type OnPropertyRemove = delegate of handle:DataModelDataEntryHandle*data:DataModelDataEntry->unit

let CreateEventDataModel ((model:DataModelData),(dtc:OnDataTypeCreate),(ops:OnPropertySet),(opr:OnPropertyRemove)) =
    let ToHandle = model.HandleSystem.ToHandle
    let FromHandle = model.HandleSystem.FromHandle
    { new IDataModel
        with
            member s.Create (datatype,data) =
                let (entry:DataModelDataEntry) = DataModelDataEntry(datatype,data)
                let hdl = ToHandle entry
                dtc.Invoke(hdl,entry)
                hdl
            member s.GetData hdl = 
                let entry = FromHandle hdl
                entry.Value
            member s.SetData (hdl,data) = 
                let entry = FromHandle hdl
                let oldVal = entry.Value
                entry.Value <- data
                ops.Invoke(hdl,oldVal,data)
            member s.Remove hdl =
                let entry = FromHandle hdl
                model.HandleSystem.RemoveObject hdl.Handle
                opr.Invoke(hdl,entry)
    }
     
type Symbol(m_name:string) =
    interface INamedObject with
        member s.Name = m_name
        
type SymbolHandle = Symbol Handle

type SymbolTableData = { HandleSystem:ObjectHandleSystem; NameIndex:NamedObjectIndex }

let CreateSymbolTableData incFunc = 
    let system = CreateObjectHandleSystem incFunc
    let idx = NamedObjectIndex()
    system.ObjectMap.AddSubCollection idx
    { HandleSystem=system; NameIndex=idx }
    
type ISymboledObject =
    abstract Symbol : SymbolHandle
    
type ISymbolTable =
    abstract Symbol : name:string -> SymbolHandle
    abstract Name : hdl:SymbolHandle -> string
    
let CreateSymbolTable (tableData:SymbolTableData) = 
    let GetOrCreateObjHandle = tableData.HandleSystem.GetOrCreateObjHandle
    let GetHandleObj = tableData.HandleSystem.GetHandleObj
    let ToHandle value = tableData.HandleSystem.ToHandle value
    let FromHandle hdl = tableData.HandleSystem.FromHandle hdl
    { new ISymbolTable with
        member s.Symbol name =
            let success,existing = tableData.NameIndex.Items.TryGetValue name
            let existing = 
                if (not success)
                    then
                        let newData = Symbol(name)
                        newData :> obj
                    else existing.Object
            ToHandle (existing :?> Symbol)
        member s.Name hdl = 
            let hdl = FromHandle hdl
            let nameable = hdl :> INamedObject
            nameable.Name
     }
     
type SymbolGroup(m_name:string,symbols:SymbolHandle seq) =
    let mutable m_symbols = symbols;
    
    member s.Contains symb =
        let item = m_symbols |> Seq.first( fun existing -> 
            if ( existing = symb) then Some existing else None )
        match item with
            | Some item -> true
            | _ -> false
            
    member s.Symbols = m_symbols |> Seq.map(fun entry -> entry)
    
    member s.AddSymbol symb =
        if (not (s.Contains symb))
            then
                let newSymbols = System.Collections.Generic.List(m_symbols)
                newSymbols.Add(symb)
                m_symbols <- (newSymbols :> SymbolHandle seq)
                
    interface INamedObject with
        member s.Name = m_name
        
type SymbolGroupHandle = SymbolGroup Handle        
        
type SymbolGroupRegistryData = { HandleSystem:ObjectHandleSystem; GroupNameIndex:NamedObjectIndex }

let CreateSymbolGroupRegistryData incFunc =
    let system = CreateObjectHandleSystem incFunc
    let nameIndex = NamedObjectIndex()
    { HandleSystem=system; GroupNameIndex=nameIndex }
    
type ISymbolGroupRegistry = 
    //Error if group already exists
    abstract CreateGroup : name:string*symbols:SymbolHandle seq -> SymbolGroupHandle
    abstract ByName : name:string -> SymbolGroupHandle option
    abstract Name : hdl:SymbolGroupHandle -> string
    abstract Symbols : hdl:SymbolGroupHandle -> SymbolHandle seq
    abstract Contains : hdl:SymbolGroupHandle*SymbolHandle -> bool
    abstract Groups : unit -> SymbolGroupHandle seq
    
let CreateSymbolGroupRegistry (regData:SymbolGroupRegistryData) =
    let GetOrCreateObjHandle = regData.HandleSystem.GetOrCreateObjHandle
    let GetHandleObj = regData.HandleSystem.GetHandleObj
    let ToHandle value = regData.HandleSystem.ToHandle value
    let FromHandle hdl = regData.HandleSystem.FromHandle hdl
    
    { new ISymbolGroupRegistry with
        member s.CreateGroup (name,symbols) = 
            let exist = regData.GroupNameIndex.Items.ContainsKey name
            match exist with
                | true -> failwith "Group with name already registered"
                | false -> 
                    let grp = SymbolGroup(name,symbols)
                    ToHandle grp
        member s.ByName name = 
            let success,exist = regData.GroupNameIndex.Items.TryGetValue name
            match success with
                | false -> None
                | true -> Some (ToHandle (exist.Object :?> SymbolGroup))
        member s.Name hdl = 
            let grp = FromHandle hdl
            (grp :> INamedObject).Name
        member s.Symbols hdl = 
            let grp = FromHandle hdl
            grp.Symbols
        member s.Contains (hdl,symbol) =
            let grp = FromHandle hdl
            grp.Contains symbol
        member s.Groups() = 
            regData.HandleSystem.ObjectMap
            |> Seq.map( fun(entry)->ToHandle (entry.Object :?> SymbolGroup) )
    }
    
let CreateSymbolDatabase() = 
    let incFunc = CreateIncFunc()
    let symData = CreateSymbolTableData incFunc
    let symbols = CreateSymbolTable symData
    let grpData = CreateSymbolGroupRegistryData incFunc
    let grp = CreateSymbolGroupRegistry grpData
    symbols,grp
    
let WriteSymbolTable (symbols:(string*int) seq) (writer:IDataWriter) =
    let symLen = Seq.length symbols
    let ints = System.Collections.Generic.List<int>()
    let strings = System.Collections.Generic.List<string>()
    symbols 
    |> Seq.iter( fun (name,handle) ->
        strings.Add name
        ints.Add handle )
    writer.Ints  <| ints.ToArray()
    writer.Strings <| strings.ToArray()
        
let ReadSymbolTable (reader:IDataReader) = 
    let ints = reader.Ints()
    let strings = reader.Strings()
    Seq.combine strings ints

type DataModelSerializationType =
    | Float = 1
    | Int = 2
    | String = 3
    | Symbol = 4
    | Bytes = 5


//Four datatypes:
//float,int,string,symbol handle
//Arrays of the above.  Anything else sucks.
let WriteDataModel (data:(int*DataModelDataEntry) seq) (writer:IDataWriter) =
    let doubles = System.Collections.Generic.List<float>()
    let stringTable = System.Collections.Generic.Dictionary<string,int>()
    let stringArray = System.Collections.Generic.List<string>()
    let main = System.Collections.Generic.List<int>()
    let ints = System.Collections.Generic.List<int>()
    let bytes = System.Collections.Generic.List<byte>()
    let IndexOf str = 
        let success,idx = stringTable.TryGetValue str
        if (not success)
            then 
                let retval = stringTable.Count
                stringTable.Add(str,retval)
                stringArray.Add str
                retval
            else
                idx
    let addRange (list:'a System.Collections.Generic.List) (data:'a seq) =
        let count = list.Count
        list.AddRange data
        list.Count - count
    data 
    |> Seq.iter( fun (hdl,entry) ->
        main.Add hdl
        main.Add (IndexOf entry.Datatype)
        match entry.Value with
            | :? float as data ->
                main.Add (int DataModelSerializationType.Float)
                main.Add 1
                doubles.Add data 
            | :? (float seq) as data ->
                main.Add (int DataModelSerializationType.Float)
                main.Add (addRange doubles data )
            | :? int as data ->
                main.Add (int DataModelSerializationType.Int)
                main.Add 1
                ints.Add data  
            | :? (int seq) as data ->
                main.Add (int DataModelSerializationType.Int)
                main.Add (addRange ints data )
            | :? string as data ->
                main.Add (int DataModelSerializationType.String)
                main.Add 1
                ints.Add (IndexOf data) 
            | :? (string seq) as data ->
                main.Add (int DataModelSerializationType.String)
                main.Add <| (data |> Seq.map(fun entry->IndexOf entry) |> addRange ints)
            | :? SymbolHandle as data ->
                main.Add (int DataModelSerializationType.Symbol)
                main.Add 1
                ints.Add data.Handle
            | :? (SymbolHandle seq) as data ->
                main.Add (int DataModelSerializationType.Symbol)
                main.Add <| (data |> Seq.map(fun entry->entry.Handle) |> addRange ints)
            | :? (byte seq) as data ->
                main.Add (int DataModelSerializationType.Bytes)
                main.Add (addRange bytes data)
            | _ -> failwith "Unhandled data type" )
            
    writer.Ints <| main.ToArray()
    writer.Doubles <| doubles.ToArray()
    writer.Ints <| ints.ToArray()
    writer.Bytes <| bytes.ToArray()
    writer.Strings <| stringArray.ToArray()
    
let ReadDataModel (reader:IDataReader) =
    let main = reader.Ints().GetEnumerator()
    let doubles = reader.Doubles().GetEnumerator()
    let ints = reader.Ints().GetEnumerator()
    let bytes = reader.Bytes()
    let strings = Array.of_seq <| reader.Strings()
    let next (enum:'a System.Collections.Generic.IEnumerator) =
        let valid = enum.MoveNext()
        match valid with
            | true -> enum.Current
            | false -> failwith "Invalid entry"
        
    let nextMain() = next main
    let nextDouble() = next doubles
    let nextInt() = next ints
    let nextSymbol() = Handle<Symbol>(nextInt())
    let byteOffset = ref 0
    let nextBytes count = 
        let retval = Array.sub bytes !byteOffset count
        byteOffset := !byteOffset + count
        retval :> obj
        
    let stringOf (idx:int) = strings.[idx]
    
    let nextString() = stringOf <| nextInt()
    
    let arrayOf (count:int) (reader:unit->'a) =
        let temp = System.Collections.Generic.List<'a>()
        for idx in 1..count do
            temp.Add <| reader()
        temp.ToArray() :> obj
    
    seq {
        while main.MoveNext() do
            let hdl = main.Current
            let dtypeStr = stringOf <| nextMain()
            let (stype:DataModelSerializationType) = enum(nextMain())
            let count = nextMain()
            let data = 
                match stype with
                    | DataModelSerializationType.Float when count = 1 -> nextDouble() :> obj
                    | DataModelSerializationType.Float -> arrayOf count nextDouble
                    | DataModelSerializationType.Int when count = 1 -> nextInt() :> obj
                    | DataModelSerializationType.Int -> arrayOf count nextInt
                    | DataModelSerializationType.Symbol when count = 1 -> nextSymbol() :> obj
                    | DataModelSerializationType.Symbol -> arrayOf count nextSymbol
                    | DataModelSerializationType.String when count = 1 -> nextString() :> obj
                    | DataModelSerializationType.String -> arrayOf count nextString
                    | DataModelSerializationType.Bytes -> nextBytes count
                    | _ -> failwith "Unhandled datatype"
            yield hdl,DataModelDataEntry(dtypeStr,data)
    }